home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dskut / reform12.zip / REFORM12.PAS < prev    next >
Pascal/Delphi Source File  |  1987-05-23  |  42KB  |  1,255 lines

  1. PROGRAM reformat;
  2. {
  3. Program to reformat any disk attached to a Olivetti PC or compatible.
  4. The progam will probably work well on any MS/PC-DOS machine running under
  5. DOS 2.xx.  Fixed disks of all sizes.  [Toad Hall note:  not correct.]
  6.  
  7. Global types }
  8.  
  9. TYPE
  10.  
  11.   Regpack    = RECORD CASE INTEGER OF
  12.                1: (ax, bx, cx, dx, bp, si, di, ds, es, flags : INTEGER);
  13.                2: (al, ah, bl, bh, cl, ch, dl, dh            : Byte);
  14.                END;
  15.  
  16.   Boot       = RECORD
  17.                  Jump:                  ARRAY[0..2] OF Byte;
  18.                  OEM :                  ARRAY[0..7] OF CHAR;
  19.                  sectorSize:            INTEGER;
  20.                  clusterSize:           Byte;
  21.                  reservedSectors:       INTEGER;
  22.                  numberOfFats:          Byte;
  23.                  rootDirSize,
  24.                  totalSectors:          INTEGER;
  25.                  mediaDescriptor:       Byte;
  26.                  fatSize,
  27.                  trackSize,
  28.                  numberOfHeads,
  29.                  numberOfHiddenSectors: INTEGER;
  30.                END;
  31.  
  32.   IntArray   = ARRAY[0..32766] OF INTEGER;
  33.  
  34.   Buffer     = ARRAY[0..32766] OF Byte;
  35.  
  36.   longInteger      = ARRAY[0..1] OF INTEGER;
  37.  
  38.   DirectoryPointer = ^DirectoryEntry;
  39.  
  40.   DirectoryEntry   = RECORD
  41.                        EntryName:          ARRAY[0..10] OF CHAR;
  42.                        attribute:          Byte;
  43.                        Reserved:           ARRAY[1..10] OF Byte;
  44.                        timeLastUpdated:    INTEGER;
  45.                        dateLastUpdated:    INTEGER;
  46.                        startingCluster:    INTEGER;
  47.                        fileSize:           longInteger;
  48.                        newStartingCluster: INTEGER;
  49.                        Next,
  50.                        SubDirectory:       DirectoryPointer;
  51.                      END;
  52.  
  53.   WorkString       = STRING[255];
  54.  
  55. CONST
  56.  
  57.   READONLY        = $01;
  58.   HIDDENFILE      = $02;
  59.   SYSTEMFILE      = $04;
  60.   VOLUMELABEL     = $08;
  61.   SUBDIRECTORY    = $10;
  62.   ARCHIVE         = $20;
  63.  
  64.   NEVERUSED       = $00;
  65.   ERASED          = $E5;
  66.  
  67.   FIXEDDISK       = $F8;
  68.   DUAL8SECTOR     = $FF;
  69.   SINGLE8SECTOR   = $FE;
  70.   DUAL9SECTOR     = $FD;
  71.   SINGLE9SECTOR   = $FC;
  72.  
  73.   Unused:          INTEGER = $0000;
  74.   ReservedMinimum: INTEGER = $0FF0;
  75.   ReservedMaximum: INTEGER = $0FF6;
  76.   BadCluster:      INTEGER = $0FF7;
  77.   LastMinimum:     INTEGER = $0FF8;
  78.   LastMaximum:     INTEGER = $0FFF;
  79.   lastNormal:      INTEGER = $0FFF;
  80.  
  81. VAR
  82.  
  83. { Drive characteristics and constants communications block }
  84.  
  85.   DriveLetter:          CHAR;
  86.   numberOfFats,
  87.   media,
  88.   defaultDrive,
  89.   driveNumber:          Byte;
  90.   freeClusters,
  91.   totalDataClusters,
  92.   firstDataSector,
  93.   fatSize,
  94.   firstFATsector,
  95.   rootDirSize,
  96.   directorySectors,
  97.   firstDirectorySector,
  98.   sectorSize,
  99.   clusterSize:          INTEGER;
  100.  
  101. { Global variables }
  102.  
  103.   Registers:            Regpack;
  104.   oldFATindex,
  105.   newFATindex,
  106.   errors,
  107.   lostClusters,
  108.   totalFiles,
  109.   hiddenFiles,
  110.   inRootDirectory,
  111.   inSubdirectories,
  112.   nonContiguousFiles,
  113.   subdirectories,
  114.   movedClusters,
  115.   clustersToMove,
  116.   count:                INTEGER;
  117.   SAVEaddress,
  118.   DTAddress:           ^Buffer;
  119.   PermutationAddress,
  120.   NewFATAddress,
  121.   OldFATAddress:       ^IntArray;
  122.   RootDir:              DirectoryPointer;
  123.   movedField,
  124.   inputField,
  125.   logField,
  126.   warningField,
  127.   errorField,
  128.   disasterField:        longInteger;
  129.   Anything,
  130.   Instr:                CHAR;
  131.   AlreadyWritten:       BOOLEAN;
  132.   DiskLabel:            ARRAY[0..10] OF CHAR;
  133.  
  134. {$I REFORMAT.INC    Toad Hall Turbo Inline disk procedure Int2526}
  135.  
  136. PROCEDURE Beep;
  137.   BEGIN
  138.     WRITE(CHR(7));
  139.   END;
  140.  
  141. PROCEDURE WriteLog(S: WorkString);
  142.   VAR
  143.     count: INTEGER;
  144.   BEGIN
  145.     GotoXY(logField[0], logField[1]);
  146.     FOR count := logField[0] TO 79 DO WRITE(' ');
  147.     GotoXY(logField[0], logField[1]);
  148.     WRITE(S);
  149.   END;  {of WriteLog}
  150.  
  151.  
  152. PROCEDURE WriteWarning(S: WorkString);
  153.   VAR
  154.     count: INTEGER;
  155.   BEGIN
  156.     GotoXY(warningField[0], warningField[1]);
  157.     FOR count := warningField[0] TO 79 DO WRITE(' ');
  158.     GotoXY(warningField[0], warningField[1]);
  159.     WRITE(S);
  160.   END;  {of WriteWarning}
  161.  
  162.  
  163. PROCEDURE WriteError(S: WorkString);
  164.   VAR
  165.     count: INTEGER;
  166.   BEGIN
  167.     GotoXY(errorField[0], errorField[1]);
  168.     FOR count := errorField[0] TO 79 DO WRITE(' ');
  169.     GotoXY(errorField[0], errorField[1]);
  170.     WRITE(S);
  171.   END;  {of WriteError}
  172.  
  173.  
  174. PROCEDURE WriteDisaster(S: WorkString);
  175.   VAR
  176.     count: INTEGER;
  177.   BEGIN
  178.     GotoXY(disasterField[0], disasterField[1]);
  179.     FOR count := disasterField[0] TO 79 DO WRITE(' ');
  180.     GotoXY(disasterField[0], disasterField[1]);
  181.     WRITE(S);
  182.   END;  {of WriteDisaster}
  183.  
  184.  
  185. PROCEDURE GetInput(VAR Instr: CHAR);
  186.   VAR
  187.     count: INTEGER;
  188.   BEGIN
  189.     GotoXY(inputField[0], inputField[1]);
  190.     FOR count := inputField[0] TO 79 DO WRITE(' ');
  191.     GotoXY(inputField[0], inputField[1]);
  192.     Beep;
  193.     READLN(Instr);
  194.     Instr := Upcase(Instr);
  195.   END;  {of GetInput}
  196.  
  197.  
  198. PROCEDURE GetInformation;
  199. { Ask DOS for information about the specified or default disk.
  200.   If we have an error return code from DOS we assume that the disk
  201.   specified was invalid. }
  202.   VAR
  203.     ValidDrive:  BOOLEAN;
  204.     InLetter:    CHAR;
  205.     Instr:       CHAR;
  206.   BEGIN
  207. { get current disk: MS-DOS function call 19h
  208.   information is returned in AL: 0 = A, 1 = B, etc.}
  209.  
  210.     WriteLog('Reading Disk Information');
  211.     Registers.ah := $19;
  212.     MSDos(Registers);
  213.     defaultDrive := Registers.al;
  214.  
  215.     IF paramcount = 0
  216.     THEN Instr   := CHR(65 + defaultDrive)
  217.     ELSE Instr   := COPY(paramstr(1), 1, 1);
  218.  
  219.     ValidDrive   := FALSE;
  220.     WITH Registers DO REPEAT
  221.       IF ORD(Instr) < 64 THEN Instr := CHR($FF);
  222.       DriveLetter := UpCase(Instr);
  223.       driveNumber := ORD(DriveLetter) - 64;
  224.       ah := $36;
  225.       dl := driveNumber;
  226.       MSDos(Registers);
  227.       IF ax <> $ffff
  228.       THEN BEGIN
  229.         driveNumber          := PRED(driveNumber);
  230.         freeClusters         := bx;
  231.         totalDataClusters    := dx;
  232.         sectorSize           := cx;
  233.         clusterSize          := ax;
  234.         firstFATsector       := 1;
  235.         count                := ( totalDataClusters + 2 ) * 3 ;
  236.         IF count MOD ( sectorSize ShR 1 ) = 0
  237.         THEN fatSize         := count DIV ( sectorSize ShL 1 )
  238.         ELSE fatSize         := count DIV ( sectorSize ShL 1 ) + 1;
  239.         firstDirectorySector := SUCC(fatSize ShL 1);
  240.         ValidDrive           := TRUE;
  241.       END
  242.       ELSE BEGIN
  243.         WriteWarning('Invalid driveletter, enter new letter!');
  244.         GetInput(Instr);
  245.         WriteWarning(' ');
  246.       END;
  247.     UNTIL ValidDrive;
  248.   END;  {of GetInformation}
  249.  
  250.  
  251. FUNCTION CarryFlag: BOOLEAN;
  252.   BEGIN
  253.     CarryFlag := ( Registers.Flags AND $01 ) <> 0 ;
  254.   END;  {of CarryFlag}
  255.  
  256.  
  257. PROCEDURE ResetDisk;
  258.   BEGIN
  259.     Registers.ah := $0D;
  260.     MSDos(Registers);
  261.   END;  {of ResetDisk}
  262.  
  263.  
  264. PROCEDURE ReadSectors(sectorNumber, numberOfSectors: INTEGER);
  265.   BEGIN
  266.     WITH Registers DO REPEAT
  267.       al := driveNumber;
  268.       cx := numberOfSectors;
  269.       dx := sectorNumber;
  270.       ds := Seg(DTAddress^);
  271.       bx := Ofs(DTAddress^);
  272.       Int2526($25);  {Toad Hall disk read}
  273.       IF CarryFlag THEN BEGIN
  274.         IF NOT AlreadyWritten
  275.         THEN BEGIN
  276.           WriteWarning('No data lost!');
  277.           WriteError('Disk read error, enter A (abort), R (retry)?');
  278.         END
  279.         ELSE BEGIN
  280.           WriteError('Probably loss of data!');
  281.           WriteDisaster('Disk read error A(bort), R(etry), I(gnore)?');
  282.         END;
  283.         Instr := '?';
  284.         REPEAT
  285.           Getinput(Instr);
  286.         UNTIL ( Instr IN ['A', 'R'] )
  287.         OR (( Instr = 'I' ) AND AlreadyWritten );
  288.         IF Instr = 'A'
  289.         THEN BEGIN
  290.           ClrScr;
  291.           HALT;
  292.         END
  293.         ELSE BEGIN
  294.           WriteError(' ');
  295.           WriteWarning(' ');
  296.           WriteDisaster(' ');
  297.           IF Instr = 'I' THEN flags := 0;
  298.        END; END;
  299.     UNTIL NOT CarryFlag;
  300.   END;  {of ReadSectors}
  301.  
  302.  
  303. PROCEDURE Write